#
# Common functions used by CGI scripts
# Some more are in FillForm.pm and ErrorForm.pm
#

package CounterCGI;

use strict;
use vars qw(@ISA @EXPORT);
# misspellings is an ugly side-effect used between printPersonTable and
# placename subroutine....
use vars qw($places $misspellings);
use Fcntl;
use FileTable;
use MD5Cookies;
use ErrorForm;
use CGI;
use PHP::Session;

require Exporter;

@ISA = qw(Exporter);

# Note: EXPORTS is not recommended by Perl guidelines, but I use it anyway
@EXPORT = qw(printMachineButtons printPersonTable htmlquote urlquote);

#my $q = CGI->new;
#my $sessid = $q->cookie("PHPSESSID");
#my $session = PHP::Session->new($sessid, { create => 1 });

# Create a list of machine buttons
sub printMachineButtons {
    my $machines = shift;
    my $key = shift;
    my @selectargs = @_;

    my @machinelist = $machines->select(@selectargs);
    my $count;
    if ($#machinelist >= 0) {
	$count = $#machinelist + 1;
	print "<hr>\n";
	print "<h2>Linux machines that you have registered ($count)</h2>\n";
	print "Push a button to edit that machine record\n";
	$count = 0;
	my $machrec;
	for $machrec (@machinelist) {
	    my $machine = $machrec->key();
	    my $machname = $machrec->{name};
	    $machname = "$machine(nameless)" if !$machname;
	    ++ $count;
	    
	    print <<EoF;
<form method=post action="/cgi-bin/runscript/machine-show.cgi">
<input type="hidden" name="key" value="$key">
<input type="hidden" name="machine" value="$machine">
$count: <input type="submit" value="$machname">
</form>
EoF
        }
    }
}

sub printPersonTable {

    my $rec = shift;
    my ($c, $s, $ct);
    $misspellings = 0;
    print <<EoF;
<table>
<tr><td>Name:</td><td>$$rec{name}
EoF
    if ($$rec{placeid}) { # cooked record
	($c, $s, $ct) = split(":", $$rec{placeid});
    
	print "<tr><td>Country:</td><td>", placename($c, $$rec{country}), "\n";
	print "<tr><td>State:</td><td>", placename("$c:$s", $$rec{state}), "\n"
	    if $s;
	print "<tr><td>City:</td><td>", placename("$c:$s:$ct", $$rec{city}), "\n"
	    if $ct || $$rec{city};
    } else {
	print "<tr><td>Country:</td><td>", $$rec{country}, "\n";
	print "<tr><td>State:</td><td>", $$rec{state}, "\n"
	    if $$rec{state};
	print "<tr><td>City:</td><td>", $$rec{city}, "\n"
	    if $$rec{city};
    }
    if ($$rec{email} =~ /@/) {
	my $my_email = $$rec{email};
	print "<tr><td>Email:</td><td>" . CounterCGI::emailCloaking($my_email, 1, '', 1) . "\n";
    } else {
	print "<tr><td>Email:</td><td>$$rec{email}\n";
    }

    if ($rec->{homepage} eq "") {
        print <<EoF;
        <tr><td>Homepage:</td><td></td></tr>
EoF
    } elsif ($rec->{homepage} !~ /^http/i && $rec->{homepage} !~ /^https/i) {
	print <<EoF;
<tr><td>Homepage:</td><td> <a href="http://$rec->{homepage}" target="_blank">http://$rec->{homepage}</a></td></tr>
EoF
    } else {
        print <<EoF;
<tr><td>Homepage:</td><td> <a href="$rec->{homepage}" target="_blank">$rec->{homepage}</a></td></tr>
EoF
    }
    print <<EoF;
<tr><td>Started:</td><td>$$rec{started}
<tr><td>Usage:</td><td>$$rec{usage}
</table>
EoF
    if ($misspellings) {
	print "<p>If some of the places marked \"unknown\" ought to be listed",
	    " in the Linux counter, please contact the relevant country manager<br>\n";
    }
}



# Return a pretty-printed, fully-commented version of a placeid
sub placename {
    my $id = shift;
    my $nameraw = shift;
    $places = Counter::openfile("places", O_RDONLY) if !$places;
    my $placerec = $places->getbykey("name", $id);
    my $name = $nameraw;

    if (!$name) { return ""};
    if ($placerec) {
	$name .= " <i>$$placerec{longname}</i>";
    } else {
	$name .= " <font color=red><i>unknown place name</i></font>";
	++ $misspellings;
    }
    return $name;
}
    
# Escape the HTML metacharacters
sub htmlquote {
    my $encode = shift;
    $encode =~ s/&/&amp;/g;        # Translate reserved HTML characters.
    $encode =~ s/</&lt;/g;
    $encode =~ s/>/&gt;/g;
    $encode;
}

# Escape the URL metacharacters
sub urlquote {
    my $name = shift;
    $name =~ s/ /+/g;
    $name =~ s/\,/%2C/g;
    return $name;
}


# Require a login.
# Note that this routine does NOT return on invalid login - it exits.

sub requirelogin {
    my $users = shift; # users file
    my $q = shift;     # CGI structure with cookie data
    my $url = shift;   # URL to redirect login screen back to

    my $logintoken;

    $logintoken = $q->cookie("login");
    if (!$logintoken) {
	$logintoken = $q->param("nocookie");
    }
    if (!$logintoken) {
	warn "Redirecting to login\n";
	# blah - should have been able to dig out the URL.
	# but runscript prevents it, somehow.
	if ($url) {
	    print $q->redirect("http://counter.li.org/person/login.php?url=$url");
	} else {
	    print $q->redirect("http://counter.li.org/person/login.php");
	}
	print "<html><head></head><body>You should not see this</body></html>\n";
	exit 0;
    }
    if ($logintoken =~ /^\d+/) {
	my $index = $&;
	my $user = $users->get($index);
	if (!defined($user)) {
	    errorForm("no such user", $index);
	} elsif (!MD5Cookies::tverify($logintoken, $user->{key})) {
	    errorForm("bogus login token", $logintoken);
	}
	return $user;
    } else {
	errorForm("bogus login token shape", $logintoken);
    }
}

sub logintoken {

    my $user = shift;
# note - cookie good for 24 hours
    my $verifier = MD5Cookies::tsign($user->key(), $user->{key}, 24*60*60);
    return $verifier;
}

sub logincookie {
    my $user = shift;
    my $q = shift;

    my $verifier = logintoken($user);
    my $domain = $ENV{HTTP_HOST};
# It turns out that the Host: header contains port numbers, but that
# cookies don't work when port numbers are included in the domainspec
# So you can't have 2 cookies for different ports on the same host.
# Go figure. Perhaps it works somewhere else.
    $domain =~ s/:\d+$//;

    my $logincookie = $q->cookie(-name => "login",
			  -value => $verifier,
			  -expires => "+24h",
			  -path => "/",
			  -domain => $domain);
    return $logincookie;
}

sub pagehead {

    my $title = shift;
    my $control = shift;
    if (!defined($control)) { print "<head>\n"; }
    print <<EoF;
<meta http-equiv="content-type" content="text/html;charset=utf-8">
<link rel="stylesheet" type="text/css" href="/css/home.css">
<title>Linux Counter: $title</title>
EoF
    if (!defined($control)) { print "</head>\n"; }
}


sub pagetop {
    my $q = shift;
    my $login = $q->cookie("login");
    # for the non-cookie logins....
    if (!$login && $q->param("login")) {
	$login = $q->param("login");
    }
    my $REMOTE_USER = $ENV{REMOTE_USER};
    my $adminuser = $q->cookie("adminuser");

    my $counter_site = "http://" . $Counter::website;
    my $secure_counter_site = "https://" . $Counter::website;

    print "<div class=\"menu\">\n<table class=\"menu\">\n" .
    "<tr>\n" .
    "<td width=\"12%\" class=\"menu\"><a class=\"head\" href=\"$counter_site/\">Home</a>\n" .
    "</td>\n";
    if ($login) { 
        print "<td width=\"18%\" class=\"menu\"><a class=\"head\" href=\"$counter_site/person/\">Homepage</a>\n" .
        "</td>\n";
    } else {
        print "<td width=\"18%\" class=\"menu\"><a class=\"head\" href=\"$counter_site/person/login.php?url=/person/\">Log in</a>\n" .
	"</td>\n";
    }
    if ($REMOTE_USER || $adminuser) {
        print "<td width=\"12%\" class=\"menu\"><a class=\"head\" href=\"$counter_site/news.php\">News</a>\n</td>\n" .
        "<td width=\"16%\" class=\"menu\"><a class=\"head\" href=\"$counter_site/reports/\">Statistics</a>\n</td>\n" .
        "<td width=\"12%\" class=\"menu\"><a class=\"head\" href=\"$secure_counter_site/adm/\">Admin</a>\n</td>\n" .
        "<td width=\"17%\" class=\"menu\" align=\"right\">" .
        "<a class=\"head\" href=\"$counter_site/organization/\">Project info</a>\n" .
        "</td>\n";
    } else { 
        print "<td width=\"20%\" class=\"menu\"><a class=\"head\" href=\"$counter_site/news.php\">News</a>\n</td>\n" .
        "<td width=\"20%\" class=\"menu\"><a class=\"head\" href=\"$counter_site/reports/\">Statistics</a>\n</td>\n" .
        "<td width=\"20%\" class=\"menu\" align=\"right\">" .
        "<a class=\"head\" href=\"$counter_site/organization/\">Project info</a>\n" .
        "</td>\n";
    }
    print "<td width=\"10%\" align=\"right\" class=\"menu\"><a class=\"head\" href=\"$counter_site/help.php\">Help</a>\n</td>\n" .
  "</tr>\n" .
"</table>\n</div>\n<div class=\"midsec\">\n";
}

sub pagebottom {
    my $w3valid = shift;

    print "</div>\n<p>\n<div class=\"footer\">\n",
    "<table class=\"footer\">\n",
    "<tr><td align=\"left\" valign=\"middle\">\n",
    "Contact: " , emailCloaking("Webmaster\@counter.li.org",1) , "\n",
    "</td>\n",
    "<td align=\"right\" valign=\"middle\">";

    if ($w3valid eq "yes") {
       print "<a href=\"http://validator.w3.org/check?uri=referer\" target=\"_blank\">",
       "<img src=\"http://www.w3.org/Icons/valid-html401\" alt=\"Valid HTML 4.01 Transitional\" height=\"31\" width=\"88\" border=\"0\"></a>";
    } else {}

    print "</td></tr>\n",
    "</table>\n",
    "</div>\n";
}

sub loggedinuser {
    my $q = shift;

    my $logintoken = $q->cookie("login");
    if ($logintoken && $logintoken =~ /^\d+/) {
        return $&;
    } else {
        return undef;
    }
}

#sub returnwithmessage {
#    my $q = shift;
#    my $message = shift;
#    my $session->set("message" => $message);
#    my $returnurl = $session->get("showpage");
#    my $session->save();
#    print $q->redirect($returnurl);
#    print <<EoF;
#<html><head>
#<title>You should have been redirected</title>
#</head><body>
#You should not have seen this. You should have been at
#<a href="$returnurl">$returnurl</a>.
#<p>
#Please report the bug to webmaster&#x40;counter.li.org.
#</body>
#</html>
#EoF
#     exit(0);
#}

# simple Javascript Cloaking
# email cloacking
# by default replaces an email with a mailto link with email cloacked
  
sub emailCloaking {
       # convert text
       my $mail_address = shift;
       my $mailto      = shift; # default is 1
       my $text        = shift; # default is '' 
       my $email       = shift; # default is 1

       $mail_address   = encoding_converter( $mail_address );
       # split email by @ symbol
       my @mail           = split(/@/, $mail_address);
       my @mail_parts     = split(/\./, $mail[1]);
       # random number
       my $rand        = int(rand(99999)) + 1;

       my $replacement    = "\n<script language=\'JavaScript\' type=\'text/javascript\'> \n";
       $replacement    .= "<!-- \n";
       $replacement    .= "var prefix = \'&#109;a\' + \'i&#108;\' + \'&#116;o\'; \n";
       $replacement    .= "var path = \'hr\' + \'ef\' + \'=\'; \n";
       $replacement    .= "var addy". $rand ." = \'". $mail[0] ."\' + \'&#64;\' + \'". join( "' + '&#46;' + '", @mail_parts ) ."\'; \n";
       if ( $mailto ) {
               # special handling when mail text is different from mail addy
               if ( $text ne '' ) {
                       if ( $email ) {
                               # convert text
                               $text   = encoding_converter( $text );
                               # split email by @ symbol
                               my @texts   = split(/@/, $text);
                               my @text_parts     = split(/\./, $texts[1]);
                               $replacement    .= "var addy_text". $rand ." = \'". $texts[0] ."\' + \'&#64;\' + \'". join( "' + '&#46;' + '", @text_parts ) ."\'; \n";
                        } else {
                                $text   = encoding_converter( $text );
                                $replacement    .= "var addy_text". $rand ." = \'". $text ."\';\n";
                        }
                        $replacement    .= "document.write( \'<a \' + path + \'\\\'\' + prefix + \':\' + addy". $rand ." + \'\\\'>\' ); \n";
                        $replacement    .= "document.write( addy_text". $rand ." ); \n";
                        $replacement    .= "document.write( \'<\\\/a>\' ); \n";
               } else {
                        $replacement    .= "document.write( \'<a \' + path + \'\\\'\' + prefix + \':\' + addy". $rand ." + \'\\\'>\' ); \n";
                        $replacement    .= "document.write( addy". $rand ." ); \n";
                        $replacement    .= "document.write( \'<\\\/a>\' ); \n";
               }
        } else {
                $replacement    .= "document.write( addy". $rand ." ); \n";
        }
        $replacement    .= "//--> \n";
        $replacement    .= "</script> \n";
        $replacement    .= "<noscript> \n";
        $replacement    .= " -- Email address protected against harvesting -- ";
        $replacement    .= "\n</noscript> \n";

        return $replacement;
}

sub encoding_converter {
        my $text = shift;
	# replace vowels with character encoding
        $text   =~ s/a/&#97;/g;
        $text   =~ s/e/&#101;/g;
        $text   =~ s/i/&#105;/g;
        $text   =~ s/o/&#111;/g;
        $text   =~ s/u/&#117;/g;

        return $text;
}
